home *** CD-ROM | disk | FTP | other *** search
Text File | 1992-06-11 | 7.8 KB | 252 lines | [TEXT/CCL2] |
- (oou-dependencies :records-u
- :macptr-u
- :draggable-svm
- :droppable-svm
- :QuickDraw-u)
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;; start with something simple
-
- (print "hello, world")
-
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;; source for simple dialog box
- ;;; something equivalent will be generated by the interface editor
-
- (setf *d* (make-instance 'dialog
- :view-subviews (list
- (make-instance 'sequence-dialog-item
- :view-nick-name :seq
- :view-size #@(150 100)
- :table-vscrollp t
- :table-hscrollp nil)
- (make-instance 'button-dialog-item
- :view-nick-name :butt
- :dialog-item-text "push me"
- :dialog-item-action 'foo))))
-
- ;pushing the button yields an error - undefined function foo
- ;no big deal we just define foo and try again
-
- (defun foo (di) (ed-beep))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;; Process Manager
-
- ;adapted from IM VI p. 29-11
- (with-returned-pstrs ((process-name ""))
-
- (rlet ((psn :ProcessSerialNumber
- :highLongOfPSN 0
- :lowLongOfPSN #$kNoProcess)
- (spec :FSSpec)
- (pinfo :ProcessInfoRec
- :processInfoLength (rlength :ProcessInfoRec)
- :processName process-name
- :processAppSpec spec))
-
- (let ((name-list nil))
- (loop
- (unless (zerop (#_GetNextProcess psn)) (return name-list))
- (unless (zerop (#_GetProcessInformation psn pinfo))
- (error "getting process info"))
- (push (%get-string process-name) name-list)))))
-
-
- ;make it into a fn - just wrap code in:
-
- (defun get-process-list ()
-
- ;;insert code here
-
- )
-
-
- (defun foo (di)
- (set-table-sequence (find-named-sibling di :seq) (get-process-list)))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;; DeskTop DataBase
-
- ;See DTDB.lisp
-
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;; multiple inheritance & mixin classes
-
- (defclass drag-item (draggable-svm static-text-dialog-item) ())
-
-
- (setf *test-w*
- (make-instance
- 'dialog
- :window-type :document
- :view-position :centered
- :view-size #@(200 100)
- :window-title "draggable-svm demo"
- :close-box-p t
- :grow-icon-p t
- :view-subviews
- (list (make-instance
- 'drag-item
- :view-position #@(10 20)
- :dialog-item-text "change my position"
- :view-nick-name :i1
- :dialog-item-action #'(lambda (di)
- (declare (ignore di))
- (ed-beep))
- :drag-end-action-fn #'(lambda (sv delta pt)
- ;end action moves the item
- (declare (ignore pt))
- (offset-view-position sv delta))
- :drag-bounds :window
- )
-
- (make-instance
- 'drag-item
- :view-position #@(10 50)
- :dialog-item-text "drag me anywhere"
- :view-nick-name :i2
- :dialog-item-action #'(lambda (di)
- (declare (ignore di))
- (print "hi,ho"))
- :drag-action-fn #'(lambda (di)
- (declare (ignore di))
- (ed-beep))
- :drag-bounds :none
- ))))
-
- ;;nothing special about static text
- ;; redefine drag-item as a button & recreate the dialog
- (defclass drag-item (draggable-svm button-dialog-item) ())
-
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;; macros
-
- ;;blast some text into the listener
- (with-focused-view *top-listener*
- (with-text-state (:txSize 48 :txFace (ash 1 #$italic))
- (#_MoveTo 20 60)
- (with-pstrs ((str "the quick brow fox"))
- (#_DrawString str))))
-
- ;;fix up listener
- (invalidate-view *top-listener*)
-
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;; What's 1000!
-
- (defun fact (n) (if (plusp n) (* n (fact (1- n))) 1))
-
- (fact 1000)
-
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;; Compiles in LISP, C, Pascal, and Fortran
-
- (* pi);/*
- #|
- */ main() { puts ("Compiled by a C compiler"); } /*
- * |# (print "Compiled by a Lisp compiler") #| *)
- program chameleon (*
- *) (output); (*
- *) begin
- writeln (*
- 1 ( *,* ) 'Compiled by a FORTRAN compiler'
- *) ('Compiled by a Pascal compiler');
- end . (*/
- #define end_pascal_comment |#'( *)
-
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;; Compiles in LISP, C, and Pascal
-
- (* pi);/*
- #|
- */ main() { puts ("Compiled by a C compiler"); } /*
- |# (print "Compiled by a Lisp compiler") #| *)
- program chameleon (output);
- begin
- writeln('Compiled by a Pascal compiler');
- end.
- (*/
- #define end_pascal_comment |#'( *)
-
-
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;; RSA
-
-
- ;;1st load RSA.lisp
-
- (defvar pub)
- (defvar pri)
-
- (multiple-value-setq (pub pri) (RSA-gen-keys 47251 35747))
-
- ;;encode & decode
- (RSA-decode-string (RSA-encode-string "the rain in spain" pub) pri)
-
- ;;digital signature
- (RSA-decode-string (RSA-encode-string "it's me 6/20/92" pri) pub)
-
-
- ;;use droppable mixin to create an rsa dialog item
- (defclass rsa-widget (droppable-svm static-text-dialog-item)
- ((public-key :accessor public-key
- :initarg :public-key)
- (private-key :accessor private-key
- :initarg :private-key)))
-
- (defun encoder-fn (di target-di offset where)
- (declare (ignore offset where))
- (set-dialog-item-text target-di (RSA-encode-string
- (dialog-item-text target-di)
- (private-key di))))
-
- (defun decoder-fn (di target-di offset where)
- (declare (ignore offset where))
- (set-dialog-item-text target-di (RSA-decode-string
- (dialog-item-text target-di)
- (public-key di))))
-
- (setf *test-w*
- (make-instance
- 'dialog
- :window-type :document
- :view-position :centered
- :view-size #@(220 200)
- :window-title "rsa demo"
- :close-box-p t
- :view-subviews
- (list (make-instance
- 'rsa-widget
- :private-key pri
- :view-position #@(10 20)
- :dialog-item-text "drag & drop to encode"
- :view-nick-name :i1
- :drop-action-fn 'encoder-fn
- :drag-bounds :none
- )
-
- (make-instance
- 'rsa-widget
- :public-key pub
- :view-position #@(10 50)
- :dialog-item-text "drag & drop to decode"
- :view-nick-name :i2
- :drop-action-fn 'decoder-fn
- :drag-bounds :none
- )
-
- (make-instance
- 'editable-text-dialog-item
- :wrap-p t
- :view-position #@(10 80)
- :view-size #@(200 100)
- :dialog-item-text "I sure hope the NSA isn't watching this demo"
- ))))